home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Bavarian / Bavarian #097 (19xx)(APS Electronic).zip / Bavarian #097 (19xx)(APS Electronic).adf / MainII (.txt) < prev    next >
AmigaBASIC Source Code  |  1996-12-24  |  44KB  |  1,906 lines
  1. '
  2. '      AMIGA - MONOPOLY
  3. '      ================
  4. '
  5. ' by   T.Riegel          S. Grunwald
  6. '      Dorfstr. 52       Schillerstr. 25
  7. '      8034 Germering    8034 Germering
  8. '      Tel.: 8411183     Tel.: 846893
  9. '
  10. ' for your Amiga 500 (1MB) / 1000 (1MB) / 2000
  11. '
  12. ' ACBM-Loading routine of DExtras V1.2
  13. '
  14.  
  15. Vorbereitungen:
  16. ON ERROR GOTO fehler
  17. SCREEN 1,640,256,4,2
  18.  WINDOW 3,"",,16,1
  19.  PALETTE 10,1,1,1
  20.   COLOR 10 : LOCATE 14,30 : PRINT "Bitte warten..."
  21.   DEFINT a-z:DEFLNG ko,mi,bli,hp,aus 
  22.   FOR a=1 TO 4
  23.   MENU a,0,1,""
  24.   NEXT a 
  25.   DIM fe$(40),bf(40),fes(40),pr(40),zg(28),hz(40),mi(240),hy(40),fa(44),gz(40)
  26.   DIM sp1(3882),sp2(4059),sp3(10452),sp4(4059),sp5(59),sp6(291),me(40),geha(40)
  27.   DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  28.  
  29. DECLARE FUNCTION AllocMem& LIBRARY                  
  30. DECLARE FUNCTION xOpen&  LIBRARY
  31. DECLARE FUNCTION xRead&  LIBRARY
  32. DECLARE FUNCTION xWrite& LIBRARY
  33.  
  34. LIBRARY ":dos.library"
  35. LIBRARY ":exec.library"
  36. LIBRARY ":graphics.library"
  37.  
  38.  
  39.   GOSUB Stringseinlesen  
  40.   RANDOMIZE TIMER
  41.   ek = INT(RND*10)+1
  42.  gk = INT(RND*10)+1
  43. bli= 12574721
  44. filename$(3)="amiga-monopoly:mono3.snd"
  45. a=3:GOSUB SAMPLELoader
  46.  
  47. Vorspann:
  48.  
  49. CLS
  50. acbmname$="amiga-monopoly:monopoly-titel.acbm"
  51. GOSUB acbmloader
  52.  
  53.  
  54. num=3:peri=180:GOSUB Soundplayer
  55. CALL FreeMem&(Adresse&(3),Laenge&(3))
  56.  
  57.  
  58.  
  59.  
  60.    ms=0
  61.    ON MOUSE GOSUB Maus.Vorsp
  62.    MOUSE ON
  63.    WHILE ms=0
  64.    kno = MOUSE(0)
  65.    a$ = INKEY$
  66.    IF a$>"1" AND a$<"7" THEN ms=1:mi=VAL(a$)
  67.    WEND
  68.    MOUSE OFF
  69.    GOTO Namen   
  70.   Maus.Vorsp:
  71.   yma=MOUSE(2)
  72.   xma=MOUSE(1)
  73.   IF yma>106 AND yma<126 THEN
  74.    IF xma<205  AND xma>152  THEN mi=2:ms=1 
  75.    IF xma<265  AND xma>212  THEN mi=3:ms=1  
  76.    IF xma<325  AND xma>272  THEN mi=4:ms=1  
  77.    IF xma<385  AND xma>332  THEN mi=5:ms=1  
  78.    IF xma<445  AND xma>392  THEN mi=6:ms=1  
  79.   END IF   
  80. RETURN
  81.  
  82. Namen:
  83. PAINT (35+mi*60,110),7,10
  84. WINDOW 4,,(20,89)-(610,100+mi*8),0,1
  85. COLOR 10  
  86. FOR a = 1 TO mi
  87.   COLOR a+1
  88.    LOCATE 1+a,22 : PRINT "Name von Spieler";a
  89.     LOCATE 1+a,40 : INPUT na$(a)
  90.     na$(a)=LEFT$(na$(a),13)
  91.     fes(a)=1 : ko(a)=30000
  92.    NEXT
  93.    WINDOW CLOSE 4 
  94.   FOR a = 0 TO 211 STEP 2 
  95.    LINE (0,a)-(640,a),0
  96.   NEXT 
  97.   FOR a = 211 TO 0 STEP -2 
  98.  LINE (0,a)-(640,a),0
  99. NEXT
  100. FOR a=0 TO 15:PALETTE a,0,0,0:NEXT
  101.  
  102. filename$(1)="amiga-monopoly:mono1.snd"
  103. a=1:GOSUB SAMPLELoader
  104. filename$(2)="amiga-monopoly:mono2.snd"
  105. a=2:GOSUB SAMPLELoader
  106.  
  107.  
  108.  
  109. Hauptprogramm:
  110.  gg = 0
  111.  IF pa = 0 THEN 
  112.    dr = dr + 1 
  113.    IF socken=1 THEN GOSUB sound2
  114.   socken=1
  115.  END IF
  116.   miet = 0
  117.   IF dr>mi THEN dr=1
  118.    wu = INT(RND*6)+1
  119.    we = INT(RND*6)+1 : nn=0
  120.    IF gef(dr) = 1 THEN
  121.    rig(dr) = rig(dr)+1
  122.    IF rig(dr) = 3 THEN rig(dr) = 0 : gef(dr) = 0 : ko(dr) = ko(dr)-1000 
  123.   END IF
  124.  IF wu = we THEN pa = pa+1 :ELSE pa=0
  125.  IF pa = 1  AND  gef (dr) = 1 THEN gef(dr)=0 : fg=1
  126.  IF pa = 3  THEN gef(dr)  = 1 : fes(dr)=11     
  127.  IF gef(dr) = 0  THEN fes(dr) = fes(dr)+we+wu
  128.  IF fes(dr) > 40 THEN fes(dr) = fes(dr)-40 : ko(dr)=ko(dr)+4000
  129.  IF fes(dr) = 1  THEN ko(dr)  = ko(dr)+4000
  130.  IF fes(dr) = 5  THEN ko(dr)  = ko(dr)-4000
  131.  IF fes(dr) = 31 THEN gef(dr) = 1
  132.  IF fes(dr) = 39 THEN ko(dr)  = ko(dr)-2000 
  133. GOSUB bpBerechnung
  134.  
  135. Hauptmenue:
  136. CLS
  137.  GOSUB Kont
  138.   COLOR dr+1
  139.   LOCATE 5,23: PRINT "Spieler         : " na$(dr)
  140.   COLOR 1
  141.   LOCATE 6,23: PRINT "Gewürfelte Zahl :";wu+we;
  142.    IF pa > 0 THEN PRINT  "(Pasch)";
  143.    IF pa = 3 THEN pa = 0 : PRINT " -> Gefängnis"
  144.    IF fg = 1 THEN fg = 0 : PRINT " -> Freigewürfelt"
  145.    LOCATE 7,23 : PRINT "Spielfeld       : ";fe$(fes(dr));
  146.    IF gef(dr) = 1 AND fes(dr) = 31 THEN PRINT " -> Gefängnis" : fes(dr)=11
  147.    LOCATE 8,23 : PRINT"Vermögen        :";ko(dr)
  148.    IF bf(fes(dr))>0 AND bf(fes(dr))<>dr AND miet=0 AND gg=0 AND hy(fes(dr))=0 THEN Mieten 
  149.    IF ko(dr)<0 THEN Ende
  150.    GOSUB Spielplan
  151.    LOCATE 11,1
  152.    COLOR 5   
  153.    PRINT TAB(27) "Nächster Zug............1"
  154.    PRINT
  155.    PRINT TAB(27) "Geschäfte führen........2"
  156.    PRINT
  157.    PRINT TAB(27) "Ihr Besitz..............3"
  158.    PRINT
  159.    PRINT TAB(27) "Grundstück kaufen.......4"
  160.    PRINT
  161.    PRINT TAB(27) "Bauen...................5"
  162.    PRINT
  163.    PRINT TAB(27) "Diskette................6"
  164.    IF nn=0 THEN
  165.     IF fes(dr)=8 OR fes(dr)=23 OR fes(dr)=37 THEN Ereigniskarten
  166.     IF fes(dr)=3 OR fes(dr)=18 OR fes(dr)=34 THEN Gemeinschaftskarten
  167.    END IF
  168.    h=11:ap=6:GOSUB Menkast
  169.   Abfrage:
  170.    IF a = 1 THEN Hauptprogramm
  171.    IF a = 2 THEN Geschaefte
  172.    IF a = 3 THEN Besitz
  173.    IF a = 4 THEN Grundstueck
  174.    IF a = 5 THEN Bauen   
  175.    IF a = 6 THEN Diskette
  176.   
  177. Geschaefte:
  178. CLS
  179.  COLOR 3
  180.  LOCATE 2,24 : PRINT "G E S C H Ä F T E  F Ü H R E N"
  181.  GOSUB Linie
  182.   COLOR 5
  183.   LOCATE 8,27
  184.   GOSUB Kont
  185.    PRINT "Grundstückhandel.......1"
  186.    PRINT
  187.    PRINT TAB(27) "Hypotheken.............2"
  188.    PRINT
  189.    PRINT TAB(27) "Freikartenhandel.......3"
  190.    PRINT
  191.    PRINT TAB(27) "Häuser verkaufen.......4"
  192.    PRINT
  193.    PRINT TAB(27) "Freikaufen.............5"
  194.    PRINT
  195.    PRINT TAB(27) "Zum Hauptmenü..........6"
  196.    h=8:ap=6
  197.    GOSUB Menkast
  198.   IF a = 1 THEN Grundstueckhandel
  199.   IF a = 2 THEN Hypotheken
  200.   IF a = 3 THEN Freikartenhandel
  201.   IF a = 4 THEN Haeuserverk
  202.   IF a = 5 THEN Freikaufen
  203.   IF a = 6 THEN Hauptmenue
  204.  
  205. Grundstueckhandel:
  206. GOSUB bpBerechnung
  207. CLS
  208.  COLOR 3
  209.  LOCATE 2,21 : PRINT "G R U N D S T Ü C K H A N D E L"
  210.  GOSUB Linie
  211.   COLOR 4
  212.   LOCATE 5,17 : PRINT "Spieler            Nummer          Vermögen"
  213.   PRINT
  214.   COLOR 1
  215.   FOR a = 1 TO mi
  216.   PRINT TAB(17) ;na$(a);TAB(37);a;TAB(53);ko(a)
  217.   PRINT 
  218.   NEXT a
  219.   PRINT TAB(17) "Menü";TAB(37)mi+1
  220.   PRINT:PRINT 
  221.   PRINT TAB(16) "Verkäufer ?"
  222.   h=7:ap=mi+1:li=15:rr=60:GOSUB Menkast
  223.   PRINT
  224.    Ab4:
  225.    gv=a
  226.    IF gv=mi+1 THEN Geschaefte
  227.    IF gv<1 OR gv>mi THEN LOCATE CSRLIN-1,16 : GOTO Ab4
  228.    PRINT : COLOR 3 
  229.    CLS 
  230.    PRINT
  231.     b=0:c=0
  232.     FOR a = 1 TO 40
  233.     IF bf(a) = gv AND hz(a) = 0 AND hy(a)=0 AND geha(a)=0 THEN 
  234.       IF b=14 THEN LOCATE 2,40
  235.        IF b<14 THEN 
  236.        PRINT TAB(12)fe$(a);TAB(31);a
  237.        hs = 1
  238.        LINE (59,b*8+7)-(76,b*8+15),5,b
  239.        LINE (60,b*8+7)-(77,b*8+15),5,b
  240.        c=c+1:me(c)=a
  241.        END IF
  242.        IF b>13 THEN 
  243.        PRINT TAB(41)fe$(a);TAB(60);a
  244.        LINE (291,(b-14)*8+7)-(308,(b-14)*8+15),5,b
  245.        LINE (292,(b-14)*8+7)-(309,(b-14)*8+15),5,b
  246.        c=c+1:me(c)=a
  247.        END IF
  248.       b=b+1
  249.     END IF
  250.     NEXT 
  251.     IF hs = 0 THEN 
  252.      PRINT : PRINT TAB(12) na$(gv) " hat kein Grundstück !"
  253.      GOSUB Abfra : GOTO Geschaefte
  254.     END IF
  255.     hs = 0
  256.      LOCATE 16: COLOR 1 :PRINT 
  257.      PRINT  TAB (12) "Grundstück (Return=Tastatur) ?"
  258.      Ab3:
  259.      sh=0
  260.      ON MOUSE GOSUB Maus.Str
  261.      MOUSE ON
  262.      WHILE sh=0
  263.      IF INKEY$=CHR$(13) THEN
  264.        PRINT TAB(12):INPUT "Nummer ";sh
  265.      END IF
  266.      WEND 
  267.      IF bf(sh)<>gv OR hz(sh) > 0 OR hy(sh) = 1 OR geha(sh)>0 THEN 
  268.       LOCATE CSRLIN-1 : GOTO Ab3
  269.      END IF
  270.      CLS
  271.      COLOR 4
  272.    LOCATE 5,17 : PRINT "Spieler            Nummer          Vermögen"
  273.    PRINT
  274.    COLOR 1
  275.    FOR a = 1 TO mi
  276.    PRINT TAB(17) ;na$(a);TAB(37);a;TAB(53);ko(a)
  277.    PRINT 
  278.    NEXT a
  279.    PRINT TAB(17) "Menü";TAB(37)mi+1
  280.    PRINT:PRINT 
  281.    COLOR 9
  282.    PRINT TAB(16) "Käufer ? ";
  283.    h=7:ap=mi+1:li=15:rr=60:GOSUB Menkast
  284.    PRINT  ": "na$(a)
  285.    kaum:
  286.    gka=a
  287.    IF gka=mi+1 THEN Geschaefte
  288.    IF gka<1 OR gka>mi THEN LOCATE CSRLIN-1,16 : GOTO kaum
  289.    PRINT : COLOR 3 
  290.      PRINT TAB(16) "Grundstück : ";fe$(sh)
  291.         pr=pr(sh)
  292.         gx=397:gy=110:GOSUB gadget
  293.         gp=pr
  294.         PRINT  TAB(16) "Preis      :"pr
  295.         xr=397:yr=130:GOSUB requester
  296.         IF re=0 THEN GOTO Geschaefte
  297.        
  298.         ko(gka) = ko(gka)-gp : ko(gv) = ko(gv)+gp : bf(sh) = gka  
  299.        IF sh = 6  OR sh = 16 OR   sh = 26 OR sh = 36 THEN ab(gv) = ab(gv)-1 : ab(gka) = ab(gka)+1
  300.        IF sh = 13 OR sh = 29 THEN aw(gv) = aw(gv)-1 : aw(gka) = aw(gka)+1
  301.        IF fes(dr) = sh THEN gg = 1
  302.  GOSUB bpBerechnung
  303. GOTO Geschaefte
  304.  
  305. Hypotheken:
  306. CLS
  307.  COLOR 3
  308.  LOCATE 2,27 : PRINT "H Y P O T H E K E N"
  309.   GOSUB Linie
  310.   COLOR 5
  311.   LOCATE 10,25
  312.   PRINT "Hpotheken aufnehmen..........1"
  313.   PRINT
  314.   PRINT TAB(25) "Hpotheken abzahlen...........2"
  315.   PRINT
  316.   PRINT TAB(25) "Zum Menü.....................3"
  317.    h=10:ap=3:GOSUB Menkast
  318.     IF a = 1 THEN Hypaufnehmen
  319.     IF a = 2 THEN Hypabzahlen
  320.     IF a = 3 THEN Geschaefte
  321.    
  322. Hypaufnehmen:
  323.   CLS
  324.   GOSUB bpBerechnung
  325.   COLOR 3
  326.   b=0:c=0:PRINT:hs=0
  327.     FOR a = 1 TO 40
  328.     IF bf(a) = dr AND hy(a) = 0 AND geha(a)=0 THEN 
  329.       IF b=14 THEN LOCATE 2,40
  330.        IF b<14 THEN 
  331.        PRINT TAB(12)fe$(a);TAB(31);a
  332.        hs = 1
  333.        LINE (59,b*8+7)-(76,b*8+15),5,b
  334.        LINE (60,b*8+7)-(77,b*8+15),5,b
  335.        c=c+1:me(c)=a
  336.        END IF
  337.        IF b>13 THEN 
  338.        PRINT TAB(41)fe$(a);TAB(60);a
  339.        LINE (291,(b-14)*8+7)-(308,(b-14)*8+15),5,b
  340.        LINE (292,(b-14)*8+7)-(309,(b-14)*8+15),5,b
  341.        c=c+1:me(c)=a
  342.        END IF          
  343.       b=b+1
  344.     END IF
  345.     NEXT 
  346.  IF hs = 0 THEN 
  347.   PRINT TAB(20) "Sie können keine Hypotheken aufnehmen !"
  348.   hs = 0
  349.   GOSUB Abfra : GOTO Hypotheken
  350.  END IF
  351.   LOCATE 17: COLOR 1 :PRINT TAB(12) "Ihr Vermögen:";ko(dr)
  352.  PRINT  TAB (12) "Grundstück (Return=Tastatur) ?"   
  353.   hmein:
  354.     sh=0
  355.      ON MOUSE GOSUB Maus.Str
  356.      MOUSE ON
  357.      WHILE sh=0
  358.      IF INKEY$=CHR$(13) THEN
  359.        PRINT TAB(12):INPUT "Nummer ";sh
  360.      END IF
  361.      WEND
  362.     IF sh = 0 THEN Hypotheken
  363.    IF sh>40 OR sh<1 THEN LOCATE CSRLIN-1,16 : sh=0:GOTO hmein
  364.    IF bf(sh)<>dr OR hz(sh) > 0 OR hy(sh) = 1 OR geha(sh)>0 THEN
  365.      LOCATE CSRLIN-1 : GOTO hmein
  366.      END IF
  367.     PRINT
  368.     COLOR 6
  369.      PRINT:PRINT TAB(12)"Hypothek auf "fe$(sh)" ?"
  370.      xr=383:yr=125
  371.      GOSUB requester
  372.      IF re=0 THEN Hypotheken     
  373.     hy(sh)=1 : ko(dr)=ko(dr)+pr(sh)/2
  374. GOTO Hypotheken
  375.   
  376. Hypabzahlen:
  377.    CLS
  378.     GOSUB bpBerechnung
  379.    COLOR 3
  380.    b=0:c=0:PRINT:hs=0:FOR a=1 TO 28:me(a)=0:NEXT
  381.     FOR a = 1 TO 40
  382.     IF bf(a) = dr AND hy(a) = 1 THEN 
  383.       IF b=14 THEN LOCATE 2,40
  384.        IF b<14 THEN 
  385.        PRINT TAB(12)fe$(a);TAB(31);a
  386.        hs = 1
  387.        LINE (59,b*8+7)-(76,b*8+15),5,b
  388.        LINE (60,b*8+7)-(77,b*8+15),5,b
  389.        c=c+1:me(c)=a
  390.        END IF
  391.        IF b>13 THEN 
  392.        PRINT TAB(41)fe$(a);TAB(60);a
  393.        LINE (291,(b-14)*8+7)-(308,(b-14)*8+15),5,b
  394.        LINE (292,(b-14)*8+7)-(309,(b-14)*8+15),5,b
  395.        c=c+1:me(c)=a
  396.        END IF          
  397.       b=b+1
  398.     END IF
  399.    NEXT 
  400.  IF hs = 0 THEN 
  401.   PRINT TAB(23) "Sie haben keine Hypotheken !"
  402.   hs = 0
  403.   GOSUB Abfra : GOTO Hypotheken
  404.  END IF
  405.   LOCATE 17: COLOR 1 :PRINT TAB(12) "Ihr Vermögen:";ko(dr)
  406.  PRINT  TAB (12) "Grundstück (Return=Tastatur) ?"    
  407.    hamein:
  408.     sh=0
  409.      ON MOUSE GOSUB Maus.Str
  410.      MOUSE ON
  411.      WHILE sh=0
  412.      IF INKEY$=CHR$(13) THEN
  413.        PRINT TAB(12):INPUT "Nummer ";sh
  414.      END IF
  415.      WEND
  416.      IF sh = 0 THEN Hypotheken
  417.      IF sh>40 OR sh<1 THEN LOCATE CSRLIN-1,16 : sh=0:GOTO hamein
  418.      IF bf(sh)<>dr OR hy(sh) = 0 THEN
  419.      LOCATE CSRLIN-1 : GOTO hamein
  420.      END IF
  421.      COLOR 6
  422.      PRINT:PRINT TAB(12)"Hypothek von "fe$(sh)" ?"
  423.      xr=383:yr=125
  424.      GOSUB requester
  425.      IF re=0 THEN Hypotheken
  426.    hy(sh)=0 : ko(dr)=ko(dr)-pr(sh)/2-pr(sh)/10
  427. GOTO Hypotheken
  428.  
  429. Freikartenhandel:
  430. CLS
  431.  COLOR 3
  432.  LOCATE 2,20 : PRINT "F r e i k a r t e n h a n d e l"
  433.  GOSUB Linie
  434.   COLOR 4
  435.    FOR a = 1 TO mi
  436.    IF fk(dr)>0 THEN f = 1
  437.    NEXT
  438.    IF f = 0 THEN
  439.     LOCATE 9,20 : PRINT "Niemand besitzt eine Freikarte !" : GOSUB Abfra
  440.     GOTO Geschaefte
  441.    END IF
  442.   f = 0
  443.   COLOR 4
  444.   LOCATE 5,16 : PRINT "Spieler            Freikarten         Nummer"
  445.   PRINT
  446.   COLOR 1
  447.   FOR a = 1 TO mi
  448.    PRINT 
  449.    PRINT TAB(16) : PRINT USING "\                 \";na$(a);STR$(fk(a));STR$(a)
  450.   NEXT
  451.   PRINT :PRINT TAB(35) "Menü"TAB(54);mi+1
  452.   COLOR 9
  453.    PRINT :PRINT :PRINT TAB(16) "Verkäufer (Nummer) ? ";
  454.   ap=mi+1:h=8:li=14:rr=60:GOSUB Menkast   
  455.   IF a=mi+1 THEN Geschaefte
  456.   gv=a
  457.     IF fk(gv) = 0 THEN LOCATE CSRLIN-1,16 : GOTO Freikartenhandel
  458.    PRINT  ": "na$(gv) 
  459.    PRINT
  460.    PRINT TAB(16) "Käufer (Nummer)    ? ";
  461.    ap=mi+1:h=8:li=14:rr=60:GOSUB Menkast
  462.    gk=a
  463.    IF a=mi+1 THEN Freikartenhandel
  464.    PRINT  ": "na$(gk) 
  465.    pr=1000:gx=400:gy=100:GOSUB gadget
  466.    PRINT
  467.    gp&=pr
  468.    xr=367:yr=110:GOSUB requester
  469.    IF re=0 THEN Geschaefte
  470.   ko(gk) = ko(gk)-gp& : ko(gv) = ko(gv)+gp& 
  471.  fk(gk)  = fk(gk)+1  : fk(gv) = fk(gv)-1
  472. GOTO Geschaefte               
  473.  
  474. Haeuserverk:
  475. CLS:c=0
  476.  COLOR 3
  477.  LOCATE 2,20 : PRINT "H ä u s e r   v e r k a u f e n"
  478.  GOSUB Linie
  479.   COLOR 4
  480.   LOCATE 8,1
  481.    IF bp(7) = dr AND hz(2)>0 OR hz(4)>0 AND bp(7) = dr THEN 
  482.     bk(0) = 1 : bk = 1
  483.     PRINT TAB(3) fe$(2)", "fe$(4)", ";TAB(52);1
  484.     c=c+1:me(1)=1
  485.    END IF
  486.    FOR a = 1 TO 6
  487.    IF bp(a) = dr AND hz(zg(3*a-2))>0 OR hz(zg(3*a-1))>0 AND bp(a) = dr OR hz(zg(3*a))>0 AND bp(a) = dr THEN
  488.    PRINT TAB(3);
  489.     FOR b = 3 TO 1 STEP -1
  490.      PRINT fe$(zg(a*3-b+1));", ";
  491.      bk(a) = 1:bk = 1
  492.     NEXT b
  493.     c=c+1:me(c)=a+1
  494.     PRINT TAB(52);a+1 
  495.    END IF
  496.    NEXT a
  497.    IF bp(8) = dr AND hz(38)>0 OR hz(40)>0 AND bp(8) = dr THEN
  498.     bk(7) = 1 : bk = 1
  499.     PRINT TAB(3) fe$(38)", "fe$(40)", ";TAB(52);8
  500.     c=c+1:me(c)=8
  501.    END IF
  502.    IF bk = 0 THEN
  503.     PRINT TAB(20) "Sie haben keine Häuser !" : GOSUB Abfra
  504.     GOTO Geschaefte
  505.    END IF
  506.     FOR a=1 TO c
  507.    LINE (440,47+8*a)-(454,55+8*a),3,b:LINE (441,47+8*a)-(455,55+8*a),3,b
  508.    NEXT
  509.    COLOR 7 : LOCATE 5,2 : PRINT" Sie haben Häuser auf :" : PRINT
  510.    bk = 0  
  511.   Haverkpl:
  512.    LOCATE 18,3 : PRINT "Wo wollen Sie Häuser verkaufen ?"
  513.     ON MOUSE GOSUB Maus.Bauver
  514.   MOUSE ON
  515.  fb=0:a$=""
  516.  WHILE fb=0
  517.  a$=INKEY$
  518.   IF a$ <> "" THEN 
  519.   IF VAL(a$) <= me(c) THEN fb = VAL(a$)
  520.   END IF 
  521.  WEND
  522.  GOTO Weiterver
  523.  Maus.Bauver:
  524.  kno=MOUSE(0)
  525.  xma=MOUSE(1)
  526.  yma=MOUSE(2)
  527.  IF xma>440 AND xma<455 AND yma>55 AND yma<55+8*c THEN
  528.    fb=me(INT((yma-55)/8)+1)
  529.    MOUSE OFF
  530.  END IF
  531.  RETURN  
  532.  Weiterver:
  533.   fb=fb-1
  534.    IF fb>7 OR fb<0 OR fb<>INT(fb) THEN Haverkpl
  535.    IF fb = 0 AND bp(7) = dr AND bk(0)>0 THEN ok
  536.    IF fb = 7 AND bp(8) = dr AND bk(7)>0 THEN ok
  537.    IF bp(fb)<>dr OR bk(fb) = 0 THEN Haverkpl
  538.    ok:
  539.    FOR a = 1 TO 8
  540.    bk(a) = 0
  541.    NEXT
  542.    Haeuserv:
  543.    CLS
  544.    COLOR 3
  545.    LOCATE 2,20 : PRINT "H ä u s e r   v e r k a u f e n"
  546.    GOSUB Linie
  547.     LOCATE 5,1
  548.     COLOR 5
  549.     PRINT " Straße                 Häuserzahl     verkaufen"
  550.     PRINT
  551.     COLOR 1
  552.     IF fb = 0 OR fb = 7 THEN
  553.      cx = 0
  554.       FOR a = 1 TO 2
  555.        IF a = 1 AND fb = 0 THEN b = 2
  556.        IF a = 2 AND fb = 0 THEN b = 4
  557.        IF a = 1 AND fb = 7 THEN b = 38
  558.        IF a = 2 AND fb = 7 THEN b = 40
  559.       LOCATE 5+a*2:PRINT TAB (2) fe$(b);TAB (27) hz(b) TAB (41);       
  560.    Hav:
  561.    FOR p=0 TO hz(b)
  562.    LOCATE 5+a*2,41+3*p:PRINT  p
  563.    LINE (321+24*p,29+16*a)-(345+24*p,40+a*16),5,b
  564.    LINE (322+24*p,30+16*a)-(346+24*p,41+a*16),4,b
  565.    NEXT p 
  566.   ON MOUSE GOSUB Mausneu.Baudree
  567.   MOUSE ON
  568.   aus(a)=-1
  569.  WHILE aus(a)=-1
  570.  a$=INKEY$
  571.   IF a$ <> "" THEN 
  572.   aus(a)=VAL(a$)
  573.   END IF 
  574.  WEND
  575.  MOUSE OFF
  576.  GOTO weee: 
  577.  Mausneu.Baudree:
  578.  kno=MOUSE(0)
  579.  xma=MOUSE(1)
  580.  yma=MOUSE(2)
  581.  IF xma>321 AND xma<346+24*p AND yma>53+16*a AND yma<65+16*a THEN
  582.  aus(a)=INT((xma-321)/24)
  583.  END IF
  584.  RETURN 
  585.  weee:  
  586.    IF hz(b)-aus(a)<0 THEN LOCATE CSRLIN-1,41 : GOTO Hav
  587.    hp = INT(fb/2+1)*500
  588.    cx = cx+aus(a)*hp
  589.      ge(a) = hz(b)-aus(a)
  590.      NEXT a  
  591.      IF ge(1)>ge(2)+1 OR ge(2)>ge(1)+1 THEN Haeuserv
  592.      hz(b-2) = ge(a-2)
  593.      hz(b)   = ge(a-1)
  594.      ko(dr)  = ko(dr)+cx
  595.      GOTO Geschaefte
  596.     END IF
  597.    cx = 0
  598.    FOR a = 3 TO 1 STEP -1
  599.    b = (zg(3*fb-a+1))
  600.    PRINT 
  601.    LOCATE 5+(4-a)*2:PRINT TAB (2) fe$(b); TAB (27) hz(b) TAB (41);
  602.   FOR p=0 TO hz(b)
  603.   PRINT TAB(41+3*p) p;
  604.   LINE (321+24*p,29+16*(4-a))-(345+24*p,40+(4-a)*16),5,b
  605.   LINE (322+24*p,30+16*(4-a))-(346+24*p,41+(4-a)*16),4,b
  606.   NEXT p
  607.   ON MOUSE GOSUB Mausneu.Baudrver
  608.  MOUSE ON
  609.  aus(a)=-1
  610.  WHILE aus(a)=-1
  611.  a$=INKEY$
  612.   IF a$ <> "" THEN 
  613.   aus(a)=VAL(a$)
  614.   END IF 
  615.  WEND
  616.  MOUSE OFF
  617.  GOTO weiterdrver
  618.  Mausneu.Baudrver:
  619.  kno=MOUSE(0)
  620.  xma=MOUSE(1)
  621.  yma=MOUSE(2)
  622.  IF xma>321 AND xma<346+24*p AND yma>29+16*(4-a) AND yma<41+16*(4-a) THEN
  623.    aus(a)=INT((xma-321)/24)
  624.  END IF
  625.  RETURN 
  626.    weiterdrver:
  627.     IF hz(b)-aus(a)<0 THEN LOCATE CSRLIN-1,41 : GOTO Hv
  628.     hp = INT(fb/2+1)*500
  629.    cx = cx+aus(a)*hp
  630.    ge(a) = hz(b)-aus(a)
  631.   NEXT a
  632.    IF ge(1)>ge(2)+1 OR ge(1)>ge(3)+1 THEN Haeuserv
  633.    IF ge(2)>ge(1)+1 OR ge(2)>ge(3)+1 THEN Haeuserv
  634.    IF ge(3)>ge(1)+1 OR ge(3)>ge(2)+1 THEN Haeuserv
  635.    FOR a = 3 TO 1 STEP -1
  636.    hz(zg(3*fb-a+1)) = ge(a)
  637.    NEXT  
  638.  ko(dr) = ko(dr)+cx  
  639.  GOSUB bpBerechnung                                       
  640. GOTO Hauptmenue 
  641.  
  642.  
  643. Freikaufen:
  644. CLS
  645.  COLOR 3
  646.  LOCATE 2,25 : PRINT "F R E I K A U F E N
  647.  GOSUB Linie
  648.   LOCATE 10,26 
  649.    IF gef(dr) = 0 THEN
  650.     COLOR 4
  651.     PRINT TAB(25) "Sie sind nicht im Gefängnis !"
  652.     GOSUB Abfra
  653.     GOTO Geschaefte
  654.    END IF
  655.   COLOR 5
  656.   PRINT "Freikaufen durch 1000.-...1"
  657.   PRINT
  658.   PRINT TAB(26) "Freikaufen durch Karte....2"
  659.   PRINT 
  660.   PRINT TAB(26) "Zum Menü..................3   
  661.   PRINT 
  662.   h=10:ap=3:GOSUB Menkast 
  663.    IF a = 1 THEN ko(dr) = ko(dr)-1000 : gef(dr)=0 : GOTO Geschaefte
  664.    IF a = 2 THEN
  665.     IF fk(dr)>0 THEN 
  666.      fk(dr) = fk(dr)-1 : gef(dr)=0 : kf=kf-1 : GOTO Geschaefte
  667.      ELSE
  668.      PRINT
  669.      COLOR 3
  670.      PRINT TAB(23) "Sie haben keine Freikarte !"
  671.     END IF
  672.    END IF 
  673.  IF a = 3 THEN Geschaefte 
  674.  
  675. Besitz:
  676.  CLS
  677.  COLOR 3
  678.  LOCATE 2,25 : PRINT "B e s i t z"
  679.  GOSUB Linie
  680.   COLOR 1 : LOCATE 5,5
  681.   PRINT "Spieler    : ";na$(dr)
  682.   PRINT TAB(5) "Vermögen   :";ko(dr)
  683.   PRINT TAB(5) "Freikarten :";fk(dr)
  684.    LOCATE 9,2 : COLOR 4
  685.    PRINT TAB(5) "Grundstück                            Hypothek"
  686.    COLOR 7                 
  687.    AREA (270,56) : AREA STEP (14,5) :AREA STEP (0,9) : AREA STEP (-28,0)
  688.    AREA STEP (0,-9) : AREAFILL
  689.    COLOR 4
  690.    AREA (174,59) : AREA STEP (10,4) :AREA STEP (0,7) : AREA STEP (-20,0)
  691.    AREA STEP (0,-7) : AREAFILL
  692.   WINDOW 4,"",(0,76)-(630,200),0
  693.   COLOR 6
  694.   b=0
  695.   PRINT 
  696.   FOR a = 1 TO 40
  697.    IF b=10 THEN GOSUB Abfra:CLS:PRINT:b=11 
  698.    IF b=21 THEN GOSUB Abfra:CLS:PRINT:b=22
  699.    IF bf(a) = dr AND hz(a) = 5 THEN 
  700.    PRINT TAB(5) fe$(a);TAB(22) " 0";TAB(34) "1"; : GOTO Bes
  701.    END IF
  702.    IF bf(a) = dr THEN PRINT TAB(5) fe$(a); TAB(22) hz(a);TAB (34)"0":b=b+1
  703.    Bes:
  704.    IF hy(a) = 1  AND bf(a) = dr THEN LOCATE CSRLIN-1,44 : PRINT pr(a)/2
  705.   NEXT a
  706. GOSUB Abfra
  707. WINDOW CLOSE 4
  708. GOTO Hauptmenue
  709.  
  710.  
  711. Grundstueck:
  712.  CLS:x=490:y=62
  713.  COLOR 3
  714.  LOCATE 2,23 : PRINT "G r u n d s t ü c k   k a u f e n"
  715.  GOSUB Linie 
  716.  IF fes(dr) = 13 THEN GOSUB Glube
  717.  IF fes(dr)=29 THEN GOSUB Aquakiki 
  718.  IF fes(dr)=6 OR fes(dr)=16 OR fes(dr)=26 OR fes(dr)=36 THEN GOSUB Lok                          
  719.  COLOR 1 : LOCATE 6,23
  720.  IF pr(fes(dr))  > 0 THEN nk = 1
  721.  IF bf(fes(dr)) <> 0 OR nk = 0 OR bf(fes(dr)) = dr THEN 
  722.   PRINT TAB(20)"Sie können '"fe$(fes(dr))"' nicht kaufen !" : nk=0
  723.   GOSUB Abfra
  724.   GOTO Hauptmenue
  725.  END IF  
  726.   nk=0 
  727.   PRINT "Ihr Vermögen      :"ko(dr)
  728.   PRINT   
  729.   PRINT TAB(23) "Sie können kaufen : ";fe$(fes(dr))
  730.   PRINT
  731.   PRINT TAB(23) "Für den Preis     :";pr(fes(dr))",-"
  732.   PRINT
  733.   xr=184
  734.   yr=100
  735.   GOSUB requester
  736.  IF re=1 THEN 
  737.   bf(fes(dr)) = dr
  738.   ko(dr) = ko(dr)-pr(fes(dr))
  739.   IF fes(dr) = 6  OR fes(dr) = 16 OR   fes(dr) = 26 OR fes(dr) = 36 THEN ab(dr) = ab(dr)+1
  740.   IF fes(dr) = 13 OR fes(dr) = 29 THEN aw(dr)  = aw(dr)+1
  741.   b=0
  742.   GOSUB bpBerechnung
  743.  END IF
  744. GOTO Hauptmenue
  745.  
  746. Bauen:
  747.  CLS
  748.  COLOR 3
  749.  LOCATE 2,31 : PRINT "B a u e n"
  750.  GOSUB Linie
  751.  COLOR 4
  752.  GOSUB bpBerechnung
  753.  LOCATE 8,1
  754.  c=0
  755.  IF bp(7) = dr THEN 
  756.    bk=1
  757.    PRINT TAB(3) fe$(2)", "fe$(4)", ";TAB(52);1
  758.    c=c+1:me(1)=1
  759.  END IF
  760.  FOR a = 1 TO 6
  761.  IF bp(a) = dr THEN
  762.   PRINT TAB(3);
  763.   FOR b = 3 TO 1 STEP -1
  764.   bk=1
  765.   PRINT fe$(zg(a*3-b+1));", ";
  766.   NEXT b
  767.   c=c+1:me(c)=a+1
  768.   PRINT TAB(52);a+1   
  769.   END IF
  770.  NEXT a
  771.  IF bp(8) = dr THEN
  772.   bk=1
  773.   PRINT TAB(3) fe$(38)", "fe$(40)", ";TAB(52);8
  774.   c=c+1:me(c)=8
  775.  END IF
  776.  IF bk = 0 THEN
  777.   PRINT TAB(25)"Sie können nicht bauen !" : GOSUB Abfra
  778.   GOTO Hauptmenue
  779.  END IF
  780.  FOR a=1 TO c
  781.  LINE (440,47+8*a)-(454,55+8*a),3,b:LINE (441,47+8*a)-(455,55+8*a),3,b
  782.  NEXT
  783.  COLOR 7 : LOCATE 5,2 : PRINT " Sie können bauen auf :" : PRINT
  784.  bk=0  
  785.  Baupl:
  786.  LOCATE 18,3 : PRINT  "Wo wollen Sie bauen ?"
  787.  ON MOUSE GOSUB Maus.Bau
  788.  MOUSE ON
  789.  fb=0:a$=""
  790.  WHILE fb=0
  791.  a$=INKEY$
  792.   IF a$ <> "" THEN 
  793.   IF VAL(a$) <= me(c) THEN fb = VAL(a$)
  794.   END IF 
  795.  WEND
  796.  GOTO Korri
  797.  Maus.Bau:
  798.  kno=MOUSE(0)
  799.  xma=MOUSE(1)
  800.  yma=MOUSE(2)
  801.  IF xma>440 AND xma<455 AND yma>55 AND yma<55+8*c THEN
  802.     fb=me(INT((yma-55)/8)+1)
  803.     MOUSE OFF
  804.  END IF
  805.  RETURN  
  806.  Korri:
  807.  fb=fb-1
  808.  IF fb = -1 THEN Hauptmenue
  809.  IF fb > 7  OR fb < 0 OR fb <> INT(fb) THEN Baupl
  810.  IF fb=0 AND bp(7)=dr THEN Haeuser
  811.  IF fb=7 AND bp(8)=dr THEN Haeuser
  812.  IF bp(fb)<>dr THEN Baupl
  813.  IF fb=7 AND bp(8)<>dr THEN Baupl
  814.  Haeuser:
  815.  awz=0:awg=0:aus(1)=0:aus(2)=0
  816.  CLS
  817.  COLOR 3
  818.  LOCATE 2,28 : PRINT "B a u e n"
  819.  GOSUB Linie
  820.  LOCATE 5,1 : COLOR 6
  821.  PRINT " Ein Haus kostet: ";INT(fb/2+1)*1000;".-"
  822.  PRINT " Ihr Vermögen   : ";ko(dr)
  823.  PRINT : COLOR 5
  824.  PRINT " Straße                 Häuserzahl     neu dazu"
  825.  COLOR 6
  826.  IF fb = 0 OR fb  = 7 THEN 
  827.  FOR a = 1 TO 2
  828.   IF a = 1 AND fb = 0 THEN b = 2
  829.   IF a = 2 AND fb = 0 THEN b = 4
  830.   IF a = 1 AND fb = 7 THEN b = 38
  831.   IF a = 2 AND fb = 7 THEN b = 40
  832.   PRINT 
  833.   PRINT TAB (2) fe$(b); TAB (27) hz(b) TAB (41) 
  834.   NeueHa:
  835.   FOR p=0 TO 5-hz(b)
  836.   LOCATE 8+a*2,41+3*p:PRINT  p
  837.   LINE (321+24*p,53+16*a)-(345+24*p,64+a*16),5,b
  838.   LINE (322+24*p,54+16*a)-(346+24*p,65+a*16),4,b
  839.   NEXT p
  840.  ON MOUSE GOSUB Mausneu.Bau
  841.  MOUSE ON
  842.  aus(a)=-1
  843.  WHILE aus(a)=-1
  844.  a$=INKEY$
  845.   IF a$ <> "" THEN 
  846.   aus(a)=VAL(a$)
  847.   END IF 
  848.  WEND
  849.  MOUSE OFF
  850.  GOTO Weidda
  851.  Mausneu.Bau:
  852.  kno=MOUSE(0)
  853.  xma=MOUSE(1)
  854.  yma=MOUSE(2)
  855.  IF xma>321 AND xma<346+24*p AND yma>53+16*a AND yma<65+16*a THEN
  856.    aus(a)=INT((xma-321)/24)
  857.  END IF
  858.  RETURN 
  859.   Weidda:
  860.   IF hz(b)+aus(a) > 5 THEN LOCATE CSRLIN-1,41 : GOTO NeueHa
  861.   hp = INT(fb/2+1)*1000
  862.   awz=awz+aus(a)*hp
  863.   awg=awg+aus(a)
  864.   ge(a)=hz(b)+aus(a)
  865.  NEXT a  
  866.   IF ge(1) > ge(2)+1 OR ge(2)>ge(1)+1 THEN Haeuser
  867.   hz(b-2)  = ge(1)
  868.   hz(b)    = ge(2)
  869.   ko(dr) = ko(dr)-awz  
  870.   GOTO Hauptmenue
  871.  END IF
  872.  awz=0:awg=0:aus(1)=0:aus(2)=0
  873.  FOR a = 3 TO 1 STEP -1
  874.   b = (zg(3*fb-a+1))
  875.   PRINT 
  876.   PRINT TAB (2) fe$(b); TAB (27) hz(b) TAB (41);
  877.   NeueH:
  878.   FOR p=0 TO 5-hz(b)
  879.   LOCATE 8+(4-a)*2,41+3*p:PRINT  p
  880.   LINE (321+24*p,53+16*(4-a))-(345+24*p,64+(4-a)*16),5,b
  881.   LINE (322+24*p,54+16*(4-a))-(346+24*p,65+(4-a)*16),4,b
  882.   NEXT p
  883.  ON MOUSE GOSUB Mausneu.Baudr
  884.  MOUSE ON
  885.  aus(a)=-1
  886.  WHILE aus(a)=-1
  887.  a$=INKEY$
  888.   IF a$ <> "" THEN 
  889.   aus(a)=VAL(a$)
  890.   END IF 
  891.  WEND
  892.  MOUSE OFF
  893.  GOTO weiterdr
  894. Mausneu.Baudr:
  895.  kno=MOUSE(0)
  896.  xma=MOUSE(1)
  897.  yma=MOUSE(2)
  898.  IF xma>321 AND xma<346+24*p AND yma>53+16*(4-a) AND yma<65+16*(4-a) THEN
  899.    aus(a)=INT((xma-321)/24)
  900.  END IF
  901.  RETURN     
  902.  weiterdr:
  903.   IF hz(b)+aus(a) > 5 THEN LOCATE CSRLIN-1,41 : GOTO NeueH
  904.   hp = INT(fb/2+1)*1000
  905.   awz=awz+aus(a)*hp
  906.   awg=awg+aus(a)
  907.   ge(a)=hz(b)+aus(a)
  908.  NEXT a
  909.  IF ge(1) > ge(2)+1 OR ge(1) > ge(3)+1 THEN Haeuser
  910.  IF ge(2) > ge(1)+1 OR ge(2) > ge(3)+1 THEN Haeuser
  911.  IF ge(3) > ge(1)+1 OR ge(3) > ge(2)+1 THEN Haeuser
  912.  FOR a = 3 TO 1 STEP -1
  913.   hz(zg(3*fb-a+1)) = ge(a)
  914.  NEXT a                                     
  915.    ko(dr) = ko(dr)-awz                                       
  916. GOTO Hauptmenue 
  917.  
  918. Spielplan:
  919.  LOCATE 5,1
  920.   COLOR 1
  921.    IF gem=0 THEN
  922.    acbmname$="spielplan.acbm"
  923.    GOSUB acbmloader
  924.  gem=1
  925.   GET (2,0)-(572,19+4),sp1
  926.   GET (572-4,0)-(629,190),sp2
  927.   GET (60,190-4)-(629,209+10),sp3
  928.   GET (2,19)-(59+4,209+10),sp4
  929.  ELSE      
  930.   PUT (2,0),sp1,PSET
  931.   PUT (572-4,0),sp2,PSET
  932.   PUT (60,190-4),sp3,PSET
  933.   PUT (2,19),sp4,PSET
  934.  END IF
  935. GOSUB Spielfiguren
  936. RETURN
  937.  
  938.  
  939. Diskette:
  940. CLS
  941.  COLOR 3
  942.  LOCATE 2,29 : PRINT "D i s k e t t e"
  943.  GOSUB Linie
  944.   LOCATE 8,27
  945.   COLOR 5
  946.   PRINT "Spielstand laden..........1"
  947.   PRINT
  948.   PRINT TAB(27) "Spielstand abspeichern....2"
  949.   PRINT 
  950.   PRINT TAB(27) "Disketteninhalt anzeigen..3" 
  951.   PRINT 
  952.   PRINT TAB(27) "Zum Menü..................4"
  953.   h=8:ap=4:GOSUB Menkast
  954.     IF a = 1 THEN Laden
  955.     IF a = 2 THEN Speichern
  956.     IF a = 3 THEN Inhalt
  957.     IF a = 4 THEN Hauptmenue   
  958.  Speichern:
  959.   LOCATE 17,23
  960.   COLOR 3
  961.   INPUT "Speichern: Dateiname ";da$
  962.    IF da$ = "" THEN Diskette
  963.    OPEN da$+"-MO-" FOR OUTPUT AS #1
  964.    WRITE #1,mi,dr,wu,we
  965.    FOR a = 1 TO mi
  966.     WRITE #1,na$(a),ko(a),fk(a),fes(a),aw(a),ab(a),gef(a)
  967.    NEXT 
  968.    FOR a = 1 TO 40
  969.     WRITE #1,bf(a),hz(a),hy(a)
  970.    NEXT 
  971.   CLOSE #1
  972.   GOTO Diskette
  973.  Laden:
  974.   LOCATE 17,23
  975.   COLOR 3
  976.   INPUT "Laden: Dateiname ";da$
  977.    IF da$ = "" THEN Diskette
  978.    OPEN "I",#1,da$+"-MO-" 
  979.    INPUT #1,mi,dr,wu,we
  980.    FOR a = 1 TO mi
  981.     INPUT #1,na$(a),ko(a),fk(a),fes(a),aw(a),ab(a),gef(a)
  982.    NEXT
  983.    FOR a = 1 TO 40
  984.     INPUT #1,bf(a),hz(a),hy(a)
  985.    NEXT
  986.   CLOSE #1
  987.   GOTO Diskette
  988.  Inhalt:
  989.   WINDOW 4,"Disketteninhalt",(155,25)-(455,195),0,1
  990.   FILES
  991.   GOSUB Abfra
  992.  WINDOW CLOSE 4
  993.  GOSUB bpBerechnung
  994. GOTO Diskette
  995.  
  996. Ereigniskarten:
  997. nn = 1
  998. ek = ek+1 : IF ek>10 THEN ek = 1
  999.  WINDOW 5,"Ereignisfeld",(50,79)-(580,171),0,1
  1000.  COLOR 5
  1001.  LOCATE 3,2 : PRINT "Auf der Karte steht :"
  1002.  PRINT TAB(2) "---------------------"
  1003.  PRINT : COLOR 1
  1004.   IF ek<>5 THEN PRINT " "ek$(ek)
  1005.   IF ek = 1 THEN fes(dr) = 40
  1006.   IF ek = 2 THEN ko(dr)  = ko(dr)+3000
  1007.   IF ek = 3 THEN ko(dr)  = ko(dr)+1000
  1008.   IF ek = 4 THEN fes(dr) = 1 : ko(dr)=ko(dr)+8000
  1009.   IF ek = 5 THEN
  1010.    IF kf = 2 THEN ek = 6 : GOTO Eka
  1011.    kf = kf+1 : PRINT " "ek$(ek)
  1012.    fk(dr) = fk(dr)+1
  1013.   END IF
  1014.   Eka:
  1015.   IF ek = 6 THEN ko(dr) = ko(dr)-300
  1016.   IF ek = 7 THEN gef(dr) = 1 : fes(dr) = 11
  1017.   IF ek = 8 THEN 
  1018.    FOR a = 1 TO mi
  1019.     IF a<>dr THEN ko(a) = ko(a)+1000 : ko(dr) = ko(dr)-1000
  1020.    NEXT
  1021.    PRINT " Das kostet ";(mi-1)*1000;".-"
  1022.   END IF
  1023.   IF ek = 9 THEN fes(dr) = 2
  1024.   IF ek = 10 THEN
  1025.    FOR a = 1 TO 40
  1026.     IF bf(a) = dr AND hz(a)<5 THEN pz = pz+hz(a)*500
  1027.     IF bf(a) = dr AND hz(a)=5 THEN pz = pz+2000
  1028.    NEXT
  1029.    ko(dr) = ko(dr)-pz
  1030.    PRINT " Das kostet ";pz;".-"
  1031.    pz = 0
  1032.   END IF
  1033.  GOSUB Abfra
  1034. WINDOW CLOSE 5
  1035. GOTO Hauptmenue
  1036.  
  1037. Gemeinschaftskarten:
  1038. nn = 1
  1039. gk = gk+1 : IF gk>10 THEN gk = 1
  1040.  WINDOW 5,"Gemeinschaftsfeld",(50,79)-(580,171),0,1
  1041.  COLOR 5
  1042.  LOCATE 3,2 : PRINT"Auf der Karte steht :"
  1043.  PRINT TAB(2) "---------------------"
  1044.  PRINT : COLOR 1
  1045.   IF gk<>8 THEN PRINT " "gk$(gk)
  1046.   IF gk = 1 THEN gef(dr) = 1:fes(dr) = 11
  1047.   IF gk = 2 THEN ko(dr) = ko(dr)+2000
  1048.   IF gk = 3 THEN ko(dr) = ko(dr)-1000
  1049.   IF gk = 4 THEN
  1050.    FOR a = 1 TO 40
  1051.     IF bf(a) = dr AND hz(a)<5 THEN pz = pz+hz(a)*800
  1052.     IF bf(a) = dr AND hz(a)=5 THEN pz = pz+2300
  1053.    NEXT
  1054.    ko(dr) = ko(dr)-pz
  1055.    PRINT " Das kostet ";pz;".-"
  1056.    pz = 0
  1057.   END IF
  1058.   IF gk = 5 THEN ko(dr) = ko(dr)-2000
  1059.   IF gk = 6 THEN ko(dr) = ko(dr)+4000
  1060.   IF gk = 7 THEN ko(dr) = ko(dr)+2000
  1061.   IF gk = 8 THEN 
  1062.    IF kf = 2 THEN gk = 9 : GOTO gka
  1063.     kf = kf+1 : PRINT " "gk$(gk)
  1064.     fk(dr) = fk(dr)+1
  1065.   END IF
  1066.   gka:
  1067.   IF gk = 9 THEN 
  1068.    FOR a = 1 TO mi
  1069.     IF a<>dr THEN ko(a) = ko(a)-1000 : ko(dr) = ko(dr)+1000
  1070.    NEXT
  1071.    PRINT " Sie erhalten ";(mi-1)*1000;".-"
  1072.   END IF
  1073.   IF gk = 10 THEN fes(dr) = 1 : ko(dr) = ko(dr)+8000
  1074.  GOSUB Abfra
  1075.  WINDOW CLOSE 5
  1076. GOTO Hauptmenue
  1077.  
  1078. Mieten:
  1079. GOSUB bpBerechnung
  1080.  COLOR 1
  1081.  LOCATE 9,23
  1082.   miet = 1
  1083.   mie = mi(fes(dr)+40*hz(fes(dr)))
  1084.    IF (bp(7)>0 AND fes(dr) = 2)  OR (bp(7)>0 AND fes(dr) = 4)  THEN 
  1085.    IF hz(fes(dr))=0 THEN mie = mie*2
  1086.    END IF
  1087.    IF (bp(8)>0 AND fes(dr) = 38) OR (bp(8)>0 AND fes(dr) = 40) THEN
  1088.    IF hz(fes(dr))=0 THEN mie = mie*2
  1089.    END IF
  1090.    IF fes(dr)>6 AND fes(dr)<38 THEN 
  1091.     IF bp(INT((fes(dr)-1)/5)) >0 AND hz(fes(dr))=0 THEN mie = mie*2
  1092.    END IF
  1093.    IF fes(dr) = 6 OR fes(dr) = 16 OR fes(dr) = 26 OR fes(dr) = 36 THEN 
  1094.      IF ab(bf(fes(dr))) = 1 THEN mie = 5
  1095.      IF ab(bf(fes(dr))) = 2 THEN mie = 10
  1096.      IF ab(bf(fes(dr))) = 3 THEN mie = 20
  1097.      IF ab(bf(fes(dr))) = 4 THEN mie = 40
  1098.     mie = mie*100
  1099.    END IF 
  1100.    IF fes(dr) = 13 OR fes(dr) = 29 THEN
  1101.     IF aw(bf(fes(dr))) = 1 THEN mie = (wu+we)*80
  1102.     IF aw(bf(fes(dr))) = 2 THEN mie = (wu+we)*200
  1103.    END IF 
  1104.   PRINT "Mieten          : Sie müssen"mie"an " na$(bf(fes(dr)));
  1105.   PRINT " zahlen."
  1106.  ko(dr) = ko(dr)-mie : ko(bf(fes(dr))) = ko(bf(fes(dr)))+mie
  1107. GOSUB Abfra
  1108. GOTO Hauptmenue
  1109.  
  1110. Ende:
  1111. PRINT 
  1112. PRINT TAB(23) "Sie besitzen kein Bargeld mehr !"
  1113. GOSUB Abfra
  1114.  FOR a = 1 TO 40
  1115.   IF bf(a) = dr AND hy(a) = 0 THEN kl = 1
  1116.  NEXT
  1117.  IF kl = 1 THEN kl = 0 : GOTO Geschaefte
  1118.  Spielende:
  1119.   CLS
  1120.   COLOR 3 : LOCATE 2,25 : PRINT "E N D E  D E S  S P I E L S"
  1121.   GOSUB Linie
  1122.    COLOR 1
  1123.    LOCATE 7,1
  1124.    FOR a = 1 TO 40
  1125.     IF bf(a)<>0 THEN 
  1126.       IF hy(a) = 0 THEN ko(bf(a)) = ko(bf(a)) + pr(a) + (hz(a)*INT(a/10)*1000)
  1127.     ELSE
  1128.       ko(bf(a)) = ko(bf(a))+pr(a)/2
  1129.     END IF
  1130.    NEXT
  1131.    FOR a  = 1 TO mi
  1132.     ko(a) = ko(a)+fk(a)*1000
  1133.    NEXT
  1134.    FOR b  = 1 TO mi
  1135.     FOR a = 1 TO mi-1
  1136.      IF ko(a)<ko(a+1) THEN SWAP ko(a),ko(a+1) : SWAP na$(a),na$(a+1)
  1137.    NEXT a,b
  1138.    PRINT
  1139.    FOR a = 1 TO mi
  1140.     IF a = 1 THEN COLOR 7 :ELSE COLOR 1
  1141.     PRINT TAB(14) a;".)  ";na$(a);TAB(36)"Gesamtvermögen:";ko(a)
  1142.   NEXT
  1143.   
  1144.   GOSUB sound2
  1145.   
  1146.   REM > Speicher zurueckgeben <
  1147.  
  1148. FOR a=1 TO 2
  1149. :
  1150. CALL FreeMem&(Adresse&(a),Laenge&(a))
  1151. :
  1152. NEXT a
  1153. REM > Ende <
  1154. :
  1155. LIBRARY CLOSE
  1156. END
  1157.  
  1158.  
  1159.  
  1160.  
  1161. bpBerechnung:
  1162. FOR a = 1 TO 8 : bp(a) = 0 : NEXT a
  1163.  FOR d = 1 TO mi
  1164.   b = 0
  1165.    FOR a = 1 TO 18 STEP 3
  1166.    b = b+1
  1167.     IF bf(zg(a)) = d AND bf(zg(a+1)) = d AND bf(zg(a+2)) = d THEN 
  1168.      IF hy(zg(a)) = 0 AND hy(zg(a+1)) = 0 AND hy(zg(a+2)) = 0 THEN bp(b) = d
  1169.     END IF
  1170.    NEXT a                                                         
  1171.    IF bf(2) = d AND bf(4) = d AND hy(2) = 0 AND hy(4) = 0 THEN bp(7) = d
  1172.    IF bf(38)= d AND bf(40)= d AND hy(38)= 0 AND hy(40)= 0 THEN bp(8) = d
  1173.  NEXT d
  1174.  
  1175. gzBerechnung:
  1176.  FOR a=1 TO 40
  1177.   gz(a)=0
  1178.  NEXT  
  1179.  FOR a = 0 TO 35 STEP 5
  1180.   FOR b = 1 TO 5
  1181.    IF b>1 THEN gz(a+b) = gz(a+b-1)+hz(a+b)
  1182.    IF b=1 THEN gz(a+b) = hz(a+b)
  1183.   NEXT b
  1184.    FOR b = 1 TO 5
  1185.     gz(a+b) = gz(a+5)
  1186.   NEXT b,a
  1187.  gz(6)  = 0 : gz(16) = 0 : gz(26) = 0 
  1188. gz(36) = 0  : gz(13) = 0 : gz(29) = 0
  1189.  
  1190. geBerechnung:
  1191. geha(2)=hz(2)+hz(4):geha(4)=geha(2)
  1192.  geha(38)=hz(38)+hz(40):geha(40)=geha(38)
  1193.   FOR a= 1 TO 18  STEP 3
  1194.   geha (zg(a))  =hz(zg(a))+hz(zg(a+1))+hz(zg(a+2))
  1195.  geha (zg(a+1))=geha(zg(a)):geha(zg(a+2))=geha(zg(a))
  1196. NEXT
  1197. RETURN
  1198.  
  1199.  
  1200.  
  1201. fehler:
  1202. x=ERR
  1203.  IF x>52 THEN 
  1204.   PRINT : PRINT " Disketten-Fehler : ";
  1205.    IF x=53 THEN PRINT "Datei nicht gefunden !"
  1206.    IF x=58 THEN PRINT "Datei existiert bereits !"
  1207.    IF x=61 THEN PRINT "Diskette voll !"
  1208.    IF x=70 THEN PRINT "Diskette ist schreibgeschützt !"
  1209.   GOSUB Abfra
  1210.   CLOSE 
  1211.   RESUME Diskette
  1212.   END IF  
  1213.   PRINT "Programmfehler !",x
  1214.  GOSUB Abfra
  1215. RESUME Hauptmenue
  1216.  
  1217. Sicher:
  1218. PRINT : PRINT TAB(16) "Alle Eingaben korrekt (j/n) ";
  1219.  Ab13:
  1220.   INPUT a$
  1221.    IF a$="j"THEN RETURN
  1222.    IF a$="n"THEN Geschaefte
  1223.  LOCATE CSRLIN-1,44
  1224. GOTO Ab13
  1225.  
  1226. Linie:
  1227.  LINE (0,20)-(640,20),3
  1228. RETURN
  1229.  
  1230. Abfra:
  1231. ON MOUSE GOSUB Maus.ab
  1232. MOUSE ON
  1233. a$=""
  1234. WHILE a$=""
  1235. a$=INKEY$ 
  1236.  POKE bli,254
  1237.   FOR t=1 TO 200:NEXT
  1238.  POKE bli,252
  1239.   FOR t=1 TO 150:NEXT
  1240. WEND
  1241. RETURN
  1242. Maus.ab:
  1243. a$="."
  1244. RETURN
  1245.  
  1246. Kont:
  1247. FOR a = 1 TO mi
  1248.  ko(a) = INT(ko(a))
  1249. NEXT 
  1250. RETURN
  1251.  
  1252. Stringseinlesen:
  1253. fe$ (1) = "L O S"
  1254. fe$ (2) = "Badstraße"
  1255. fe$ (3) = "Gemeinschaftsfeld"
  1256. fe$ (4) = "Turmstraße"
  1257. fe$ (5) = "Einkommensteuer"
  1258. fe$ (6) = "Südbahnhof" 
  1259. fe$ (7) = "Chausseestraße"
  1260. fe$ (8) = "Ereignisfeld"
  1261. fe$ (9) = "Elisenstraße"
  1262. fe$(10) = "Poststraße"
  1263. fe$(11) = "Gefängnis"
  1264. fe$(12) = "Seestraße"
  1265. fe$(13) = "E-Werk"
  1266. fe$(14) = "Hafenstraße"
  1267. fe$(15) = "Neue Straße"
  1268. fe$(16) = "Westbahnhof"
  1269. fe$(17) = "Münchner Straße"
  1270. fe$(18) = "Gemeinschaftsfeld"
  1271. fe$(19) = "Wiener Straße"
  1272. fe$(20) = "Berliner Straße"
  1273. fe$(21) = "Frei Parken"
  1274. fe$(22) = "Theaterstraße"
  1275. fe$(23) = "Ereignisfeld"
  1276. fe$(24) = "Museumsstraße"
  1277. fe$(25) = "Opernplatz"
  1278. fe$(26) = "Nordbahnhof"
  1279. fe$(27) = "Lessingstraße"
  1280. fe$(28) = "Schillerstraße"
  1281. fe$(29) = "Wasserwerk"
  1282. fe$(30) = "Goethestraße"
  1283. fe$(31) = "Ins Gefängnis!"
  1284. fe$(32) = "Rathausplatz"
  1285. fe$(33) = "Hauptstrasse"
  1286. fe$(34) = "Gemeinschaftsfeld"
  1287. fe$(35) = "Bahnhofstraße"
  1288. fe$(36) = "Hauptbahnhof"
  1289. fe$(37) = "Ereignisfeld"
  1290. fe$(38) = "Parkstraße"
  1291. fe$(39) = "Zusatzsteuer"
  1292. fe$(40) = "Schloßallee"
  1293. ek$ (1) = "Rücken Sie vor bis zur Schloßallee !"
  1294. ek$ (2) = "Miete und Anleihzinsen werden fällig. Sie erhalten 3000.-"
  1295. ek$ (3) = "Die Bank zahlt Ihnen eine Dividende in Höhe von 1000.-"
  1296. ek$ (4) = "Rücken Sie bis auf LOS vor !"
  1297. ek$ (5) = "Sie erhalten eine Freikarte."
  1298. ek$ (6) = "Strafe für zu schnelles Fahren : 300.-"
  1299. ek$ (7) = "Gehen Sie in das Gefängnis !"
  1300. ek$ (8) = "Sie werden zum Vorstand gewählt. Zahlen Sie jedem Spieler 1000.-"
  1301. ek$ (9) = "Zurück zur Badstraße !"
  1302. ek$(10) = "Lassen Sie Ihre Häuser renovieren !"
  1303. gk$ (1) = "Gehen Sie in das Gefängnis !"
  1304. gk$ (2) = "Die Jahresrente von 2000.- wird fällig."
  1305. gk$ (3) = "Zahlen Sie Arztkosten in Höhe von 1000.- !"
  1306. gk$ (4) = "Sie werden zu Straßenausbesserungsarbeiten herangezogen."
  1307. gk$ (5) = "Zahlen Sie 2000.- an das Krankenhaus !"
  1308. gk$ (6) = "Bankirrtum zu Ihren Gunsten. Sie erhalten 4000.-"
  1309. gk$ (7) = "Sie erben 2000.-"
  1310. gk$ (8) = "Sie erhalten eine Freikarte."
  1311. gk$ (9) = "Ihr Geburtstag. Jeder Spieler zahlt Ihnen 1000.-"
  1312. gk$(10) = "Rücken Sie vor bis auf LOS !"
  1313. FOR a = 1 TO 40
  1314.  READ pr(a)
  1315.  pr(a) = pr(a)*100
  1316. NEXT 
  1317. Grundstpreise:
  1318. DATA ,12,,12,,40,20,,20,24,,28,30,28,32,40,36,,36,40,
  1319. DATA 44,,44,48,40,52,52,30,56,,60,60,,64,40,,70,,80
  1320. Gruppen:
  1321. DATA 7,9,10,12,14,15,17,19,20,22,24,25,27,28,30,32,33,35,2,4,38,40
  1322. FOR a = 1 TO 22
  1323.  READ zg(a)
  1324. NEXT a
  1325. Mietpreise:
  1326. FOR a = 1 TO 240 
  1327.  READ mi(a) 
  1328.  mi(a) = mi(a)*10
  1329. NEXT 
  1330. DATA ,4,,8,,,12,,12,16,,20,,20,24,,28,,28,32,,36,,36,40,,44,44,,48
  1331. DATA ,52,52,,56,,,70,,100,,20,,40,,,60,,60,80,,100,,100,120,,140,,140
  1332. DATA 160,,180,,180,200,,220,220,,240,,260,260,,300,,,350,,400,,60,
  1333. DATA 120,,,180,,180,200,,300,,300,360,,400,,400,440,,500,,500,600,
  1334. DATA 660,660,,720,,780,780,,900,,,1000,,1200,,180,,360,,,540,,540,600
  1335. DATA ,900,,900,1000,,1100,,1100,1200,,1400,,1400,1500,,1600,1600,,1700
  1336. DATA ,1800,1800,,2000,,,2200,,2800,,320,,640,,,800,,800,900,,1250,
  1337. DATA 1250,1400,,1500,,1500,1600,,1750,,1750,1850,,1950,1950,,2050,
  1338. DATA 2200,2200,,2400,,,2600,,3400,,500,,900,,,1100,,1100,1200,,1500
  1339. DATA ,1500,1800,,1900,,1900,2000,,2100,,2100,2200,,2300,2300,,2400,
  1340. DATA 2550,2550,,2800,,,3000,,4000
  1341. Colors:
  1342. FOR a = 1 TO 40 
  1343.  READ fa(a)
  1344. NEXT
  1345. DATA ,8,,8,,,6,,6,6,,9,,9,9,,3,,3,3,,7,,7,7,,5,5,,5
  1346. DATA ,4,4,,4,,,2,,2
  1347. RETURN
  1348.  
  1349. Koords:
  1350. ko=MOUSE(0)
  1351. yma=MOUSE(2)
  1352. xma=MOUSE(1)
  1353. RETURN
  1354.  
  1355. Spielfiguren:
  1356.  FOR a = 1 TO mi 
  1357.    IF fes(a)<=10 THEN 
  1358.     IF (a/2) <> INT(a/2) THEN 
  1359.      CIRCLE (fes(a)*57-27+4*a,9),6,11,,,0.9 
  1360.      PAINT  (fes(a)*57-27+4*a,9),a+1,11 
  1361.     ELSE
  1362.      CIRCLE (fes(a)*57-23-4*a,9),6,11,,,0.9 
  1363.      PAINT  (fes(a)*57-23-4*a,9),a+1,11 
  1364.     END IF
  1365.    END IF     
  1366.    IF fes(a)>10 AND fes(a)<=20 THEN
  1367.     IF (a/2) <> INT(a/2) THEN
  1368.      CIRCLE (602+4*a,19*(fes(a)-10)-9),6,11,,,0.9 
  1369.      PAINT  (602+4*a,19*(fes(a)-10)-9),a+1,11  
  1370.     ELSE
  1371.      CIRCLE (606-4*a,19*(fes(a)-10)-9),6,11,,,0.9 
  1372.      PAINT  (606-4*a,19*(fes(a)-10)-9),a+1,11 
  1373.     END IF
  1374.    END IF
  1375.    IF fes(a)>20 AND fes(a)<=30 THEN
  1376.     IF (a/2) <> INT(a/2) THEN
  1377.      CIRCLE (659-(fes(a)-20)*57+4*a,200),6,11,,,0.9 
  1378.      PAINT  (659-(fes(a)-20)*57+4*a,200),a+1,11
  1379.      ELSE
  1380.      CIRCLE (663-(fes(a)-20)*57-4*a,200),6,11,,,0.9 
  1381.      PAINT  (663-(fes(a)-20)*57-4*a,200),a+1,11     
  1382.     END IF
  1383.    END IF      
  1384.    IF fes(a)>30 THEN
  1385.     IF (a/2) <> INT(a/2) THEN
  1386.      CIRCLE (32+4*a,218-19*(fes(a)-30)),6,11,,,0.9 
  1387.      PAINT  (32+4*a,218-19*(fes(a)-30)),a+1,11 
  1388.      ELSE 
  1389.      CIRCLE (36-4*a,218-19*(fes(a)-30)),6,11,,,0.9 
  1390.      PAINT  (36-4*a,218-19*(fes(a)-30)),a+1,11       
  1391.     END IF
  1392.    END IF
  1393.  NEXT a         
  1394. RETURN
  1395.      
  1396. Menkast:
  1397. ob=h*8-13
  1398.  li=li*8:rr=rr*8
  1399.   IF li=0 THEN li=170
  1400.   IF rr=0 THEN rr=448
  1401.    FOR a=1 TO ap
  1402.    LINE (li,ob+(a-1)*16)-(rr,ob+a*16),12,b
  1403.    LINE (li+1,1+ob+(a-1)*16)-(rr+1,1+ob+a*16),1,b
  1404.    NEXT
  1405.    GOSUB Sound1
  1406.    ON MOUSE GOSUB maus.men
  1407.    MOUSE ON
  1408.     ma=0
  1409.     WHILE ma=0
  1410.      b$=INKEY$
  1411.      IF VAL(b$)>=1 AND VAL(b$)<= ap THEN a$=b$:ma=1
  1412.    a=MOUSE(0)
  1413.    WEND 
  1414.   a=VAL(a$)
  1415.  MOUSE OFF
  1416. li=0:rr=0
  1417. RETURN
  1418. maus.men:
  1419. xma=MOUSE(1)
  1420. yma=MOUSE(2)
  1421. IF xma>li AND xma<rr THEN
  1422.  IF yma>ob AND yma<ob+ap*16 THEN a$=STR$(INT((yma-ob)/16)+1):ma=1
  1423. END IF
  1424. RETURN
  1425.  
  1426. requester:
  1427. re=2
  1428.  WINDOW 2,,(xr,yr)-(xr+200,yr+50),18,1
  1429.  COLOR 10
  1430.  PRINT
  1431.  PRINT TAB(3) "Alles klar ?"
  1432.  COLOR 1
  1433.  LOCATE 5
  1434.  PRINT PTAB(42) "OK" PTAB(134) "Nein"
  1435.  LINE (20 ,27)-(80,43),2,b
  1436.  LINE (120,27)-(180,43),2,b
  1437.  LINE (21 ,28)-(81,44),6,b
  1438.  LINE (121,28)-(181,44),6,b
  1439.  ON MOUSE GOSUB Maus.requ
  1440.  MOUSE ON
  1441.  WHILE re=2
  1442.  a$=INKEY$
  1443.  IF a$="o" THEN re=1
  1444.  IF a$="n" THEN re=0
  1445.  WEND
  1446.  MOUSE OFF
  1447.  WINDOW CLOSE 2
  1448. RETURN
  1449. Maus.requ:
  1450.  a=MOUSE(0)
  1451.  xma=MOUSE(1)
  1452.  yma=MOUSE(2)
  1453.  IF yma>27 AND yma<43 THEN
  1454.   IF xma>20 AND xma<80 THEN PAINT (30,30),7,6 : re=1
  1455.   IF xma>120 AND xma<180 THEN PAINT (130,30),7,6 : re=0 
  1456.  END IF
  1457. RETURN
  1458.  
  1459. Lok:
  1460. RESTORE Loko
  1461. COLOR 12
  1462. AREA (x,y):FOR m=1 TO 18:READ a,b:AREA STEP (a,b):NEXT:AREAFILL
  1463. AREA (x+18,y-9):FOR m=1 TO 11:READ a,b:AREA STEP (a,b):NEXT:AREAFILL
  1464. FOR b=1 TO 2:FOR a=1 TO 2
  1465. CIRCLE (INT(x-35+a*10+b*23.5),y+2),3,12,,,0.4
  1466. PAINT (INT(x-35+a*10+b*23.5),y+2),12
  1467. NEXT a,b
  1468. Loko:
  1469. DATA -7,,,1,-2,,,-3,2,,,1,5,,-2,-1,-1,-1,,-2,1,-1,3,-1,7,,-2,-5,7,
  1470. DATA -2,5,8,0,0,-2,4,2,5,,,-5,10,,,1,-9,,,4,8,,,6,-1,1,-36,
  1471. RETURN
  1472.  
  1473. Fragz:
  1474. FOR a=1 TO 5
  1475. CIRCLE (x+7+a,y+6),8,fabe,2,3.4                                                          
  1476. CIRCLE (x+a,y),10,fabe, 5.5,3,0.4
  1477. LINE (x+8+a,y+3)-(x+2+a,y+5),fabe
  1478. CIRCLE (x-1+a,y+10),2,fabe
  1479. NEXT a
  1480. RETURN
  1481.  
  1482.  
  1483.  
  1484. Aquakiki:
  1485. CIRCLE (x,y),9,6,6.28,1.6,0.35
  1486. CIRCLE (x-1,y+3),4,6,6.28,1.6,0.4
  1487. LINE (x+10,y)-(x+10,y+5),6
  1488. LINE (x+3,y+4)-(x+3,y+5),6
  1489. LINE (x+10,y+5)-(x+3,y+5),6
  1490. LINE (x-1,y+1)-(x-30,y+1),6
  1491. LINE (x-1,y-3)-(x-30,y-3),6
  1492. LINE (x-30,y+1)-(x-30,y-3),6
  1493. PAINT (x-29,y),6
  1494. LINE (x-10,y-3)-(x-12,y-8),6,bf
  1495. COLOR 6
  1496. AREA (x-11,y-8)
  1497. AREA (x-18,y-7)
  1498. AREA (x-18,y-10)
  1499. AREA (x-11,y-9) 
  1500. AREA (x-11,y-8)
  1501. AREA (x-4,y-7)
  1502. AREA (x-4,y-10)
  1503. AREA (x-11,y-9)
  1504. AREAFILL
  1505. RETURN
  1506.  
  1507. Glube:
  1508. CIRCLE (x,y),8,5,,,0.51
  1509. PAINT (x,y),5
  1510. LINE (x-4,y+4)-(x+4,y+10),12,bf
  1511. LINE (x-3,y+6)-(x+3,y+7),0
  1512. LINE (x-3,y+8)-(x+3,y+9),0
  1513. LINE (x+1,y+5)-(x+3,y+5),0
  1514. LINE (x-3,y+3)-(x+3,y),0,b
  1515. LINE (x+15,y-3)-(x+23,y-5),5
  1516. LINE (x+18,y+2)-(x+26,y+3),5
  1517. LINE (x-15,y-3)-(x-22,y-5),5
  1518. LINE (x-14,y+2)-(x-23,y+4),5
  1519. RETURN
  1520.  
  1521.  
  1522. Maus.Str:
  1523. aus=0
  1524. kno=MOUSE(0)
  1525. xma=MOUSE(1)
  1526. yma=MOUSE(2)
  1527. IF xma>59 AND xma<77 AND  yma>7 AND yma<119 THEN
  1528.  aus=INT((yma)/8):MOUSE OFF
  1529. END IF
  1530. IF xma>291 AND xma<309 AND yma>7 AND yma<119 THEN
  1531.  aus =INT((yma)/8)+14:MOUSE OFF
  1532. END IF
  1533. sh=me(aus)
  1534. RETURN
  1535.  
  1536. gadget:
  1537. mpr=0
  1538. WINDOW 7,,(gx,gy)-(gx+220,gy+64),2,1
  1539.  FOR a=0 TO 1
  1540.   LINE (27+a,27) - (47+a,27),1
  1541.    LINE (37+a,22) - (37+a,32),1 
  1542.   LINE (102+a,27)-(120+a,27),1
  1543.  NEXT
  1544.  LOCATE 4,23:PRINT "OK"
  1545.  fa=7
  1546.  FOR a=0 TO 2
  1547.   IF a=2 THEN fa=3
  1548.   LINE (19+a,16+a) - (56+a,38+a),fa,b
  1549.    LINE (a+93,16+a) -(130+a,38+a),fa,b
  1550.   LINE (a+166,16+a)-(203+a,38+a),fa,b
  1551. NEXT
  1552. Schl:
  1553. COLOR 3
  1554. LOCATE 7,4:PRINT "Preis : ";pr
  1555.  kno=MOUSE(0)
  1556.  kno=MOUSE(0)
  1557.   ON MOUSE GOSUB Mauspre
  1558.   MOUSE ON
  1559.    WHILE mpr=0
  1560.    a$=INKEY$
  1561.    IF a$<>"" THEN GOSUB Tastpre
  1562.   WEND
  1563. WINDOW CLOSE 7
  1564. RETURN
  1565. Tastpre:
  1566.  IF a$="+" THEN pr=pr+20
  1567.   IF a$="-"AND pr>=20 THEN pr=pr-20
  1568.  IF a$="o" THEN mpr=1:MOUSE OFF
  1569. LOCATE 7,4:PRINT "Preis : ";pr
  1570. RETURN
  1571. Mauspre:
  1572. WHILE MOUSE(0)<0 
  1573.  kno=MOUSE(0)
  1574.   xma=MOUSE(1)
  1575.    yma=MOUSE(2)
  1576.    IF xma>19 AND xma<56 AND yma>16 AND yma<38 THEN pr=pr+20
  1577.    IF xma>93 AND xma<130 AND yma>16 AND yma<38 AND pr>=20 THEN pr=pr-20             
  1578.    IF xma>166 AND xma<203 AND yma>16 AND yma<38 THEN mpr=1:MOUSE OFF   
  1579.  LOCATE 7,4:PRINT "Preis : ";pr 
  1580. WEND        
  1581. RETURN
  1582.  
  1583.  
  1584. acbmloader:
  1585.  
  1586.  
  1587. GetNames:
  1588. IF (acbmname$ = "") GOTO Mcleanup2
  1589.  
  1590. REM - ACBM-Bild laden
  1591. loadError$ = ""
  1592. GOSUB LoadACBM
  1593. IF loadError$ <> "" THEN GOTO Mcleanup
  1594.  
  1595. IF acbmname$="spielplan.acbm" THEN 
  1596.   PALETTE 0,0,0,0     'Hintergrund: schwarz
  1597.   PALETTE 1,1,1,1     'weiß
  1598.   PALETTE 2,0.2,0.4,1   'dunkelblau
  1599.   PALETTE 3,1,0.53,0   'orange
  1600.   PALETTE 4,0,0.7,0.1   'gruen
  1601.   PALETTE 5,1,1,0.13   'gelb
  1602.   PALETTE 6,0.35,0.7,1  'hellblau
  1603.   PALETTE 7,0.9,0.1,0.1  'rot
  1604.   PALETTE 8,0.5,0.07,0.8 'lila
  1605.   PALETTE 9,1,0.33,0.95 'hellila
  1606.   PALETTE 10,0.2,1,0.2  'hellgruen
  1607.   PALETTE 11,0,0,0    'Vordergrund: schwarz
  1608.   PALETTE 12,0.6,0.6,0.5 'grau
  1609.  
  1610.   COLOR dr+1
  1611.   LOCATE 5,23: PRINT "Spieler         : " na$(dr)
  1612.   COLOR 1
  1613.   LOCATE 6,23: PRINT "Gewürfelte Zahl :";wu+we;
  1614.   IF pa > 0 THEN PRINT  "(Pasch)";
  1615.   LOCATE 7,23 : PRINT "Spielfeld       : ";fe$(fes(dr));
  1616.   LOCATE 8,23 : PRINT"Vermögen        :";ko(dr)
  1617.  
  1618. END IF
  1619.   
  1620. Mcleanup:
  1621. Mcleanup2:
  1622.  
  1623.  
  1624. '  Zurueck zum Hauptprogramm
  1625.  
  1626.  
  1627. RETURN
  1628.  
  1629.  
  1630. LoadACBM:
  1631. '" - Folgende Variablen müssen 
  1632. '" - initialisiert sein:
  1633. REM -    ACBMname$ (ACBM-Dateiname)
  1634.  
  1635. REM - Variablen initialisieren
  1636. f$ = acbmname$
  1637. fHandle& = 0
  1638. mybuf& = 0
  1639. foundBMHD = 0
  1640. foundCMAP = 0
  1641. foundCAMG = 0
  1642. foundCCRT = 0
  1643. foundABIT = 0
  1644.  
  1645. REM - aus include/libraries/dos.h
  1646. REM - MODE_NEWFILE = 1006 
  1647. REM - MODE_OLDFILE = 1005
  1648.  
  1649. filename$ = f$ + CHR$(0)
  1650. fHandle& = xOpen&(SADD(filename$),1005)
  1651. IF fHandle& = 0 THEN
  1652.    loadError$ = "Eingabedatei nicht gefunden/lesbar."
  1653.    GOTO Lcleanup
  1654. END IF
  1655.  
  1656.  
  1657. REM - Pufferspeicherplatz reservieren
  1658. ClearPublic& = 65537
  1659. mybufsize& = 360
  1660. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  1661. IF mybuf& = 0 THEN
  1662.    loadError$ = "Pufferspeicherplatz nicht verfügbar."
  1663.    GOTO Lcleanup
  1664. END IF
  1665.  
  1666. inbuf& = mybuf&
  1667. cbuf& = mybuf& + 120
  1668. ctab& = mybuf& + 240
  1669.  
  1670.  
  1671. REM - Eingabe sollte lauten  FORMnnnnACBM
  1672. rLen& = xRead&(fHandle&,inbuf&,12)
  1673. tt$ = ""
  1674. FOR kk = 8 TO 11
  1675.    tt% = PEEK(inbuf& + kk)
  1676.    tt$ = tt$ + CHR$(tt%)
  1677. NEXT
  1678.  
  1679. IF tt$ <> "ACBM" THEN 
  1680.    loadError$ = "Keine ACBM-Grafikdatei."
  1681.    GOTO Lcleanup
  1682. END IF
  1683.  
  1684. REM - ACBM-Datei Chunk-weise lesen
  1685.  
  1686. ChunkLoop:
  1687. REM - Chunk-Name/Länge ermitteln
  1688.  rLen& = xRead&(fHandle&,inbuf&,8)
  1689.  icLen& = PEEKL(inbuf& + 4)
  1690.  tt$ = ""
  1691.  FOR kk = 0 TO 3
  1692.     tt% = PEEK(inbuf& + kk)
  1693.     tt$ = tt$ + CHR$(tt%)
  1694.  NEXT   
  1695.     
  1696. IF tt$ = "BMHD" THEN  'BitMap-Header 
  1697.    foundBMHD = 1
  1698.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  1699.    iWidth%  = PEEKW(inbuf&)
  1700.    iHeight% = PEEKW(inbuf& + 2)
  1701.    idepth%  = PEEK(inbuf& + 8)  
  1702.    iCompr%  = PEEK(inbuf& + 10)
  1703.    scrwidth%  = PEEKW(inbuf& + 16)
  1704.    scrheight% = PEEKW(inbuf& + 18)
  1705.  
  1706.    iRowBytes% = iWidth% /8
  1707.    scrRowBytes% = scrwidth% / 8
  1708.    nColors%  = 2^(idepth%)
  1709.  
  1710.    '" - Genug Platz für Videospeicher ?
  1711.    AvailRam& = FRE(-1)
  1712.    NeededRam& = ((scrwidth%/8)*scrheight%*(idepth%+1))+5000
  1713.    IF AvailRam& < NeededRam& THEN
  1714.       loadError$ = "Speicherplatz reicht nicht aus."
  1715.       GOTO Lcleanup
  1716.    END IF
  1717.  
  1718.    kk = 1
  1719.    IF scrwidth% > 320 THEN kk = kk + 1
  1720.    IF scrheight% > 200  THEN kk = kk + 2
  1721.  
  1722.    'SCREEN 2,scrWidth%,scrHeight%,iDepth%,2
  1723.    'WINDOW 3,"MONO",,7,2
  1724.  
  1725.  
  1726.    REM - Adressen von Screen-Structures ermitteln
  1727.    GOSUB GetScrAddrs
  1728.  
  1729.    REM - Schirm während Ladevorgang dunkel
  1730.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  1731.  
  1732.  
  1733. ELSEIF tt$ = "CMAP" THEN  'Farbpalette
  1734.    foundCMAP = 1
  1735.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  1736.  
  1737.    REM - Farbpalette aufbauen
  1738.    FOR kk = 0 TO nColors% - 1
  1739.       red% = PEEK(cbuf&+(kk*3))
  1740.       gre% = PEEK(cbuf&+(kk*3)+1)
  1741.       blu% = PEEK(cbuf&+(kk*3)+2)
  1742.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  1743.       POKEW(ctab&+(2*kk)),regTemp%
  1744.    NEXT
  1745.  
  1746.  
  1747. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  1748.    foundCAMG = 1
  1749.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  1750.    camgModes& = PEEKL(inbuf&)
  1751.  
  1752.  
  1753. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  1754.    foundABIT = 1
  1755.  
  1756.    '" - Hier werden nur volle BitMaps verarbeitet, keine 
  1757.    '" - Ausschnitte wie z.B. Pinsel (Brushes).
  1758.    '" - Sehr schnell, liest ganze BitPlanes.
  1759.    plSize& = (scrwidth%/8) * scrheight%
  1760.    FOR pp = 0 TO idepth% -1
  1761.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  1762.    NEXT
  1763.  
  1764.  
  1765. ELSE 
  1766.    REM - unbekannten Chunk-Typ lesen  
  1767.    FOR kk = 1 TO icLen&
  1768.       rLen& = xRead&(fHandle&,inbuf&,1)
  1769.    NEXT
  1770.    '" - Wenn Länge ungerade, noch 1 Byte lesen
  1771.    IF (icLen& OR 1) = icLen& THEN 
  1772.       rLen& = xRead&(fHandle&,inbuf&,1)
  1773.    END IF
  1774.       
  1775. END IF
  1776.  
  1777.  
  1778. REM - Fertig, wenn alle Chunks gelesen
  1779. IF foundBMHD AND foundCMAP AND foundABIT THEN
  1780.    GOTO GoodLoad
  1781. END IF
  1782.  
  1783. REM - Lesen ok, nächsten Chunk lesen
  1784. IF rLen& > 0 THEN GOTO ChunkLoop
  1785.  
  1786. IF rLen& < 0 THEN  ' Lesefehler
  1787.    loadError$ = "Lesefehler."
  1788.    GOTO Lcleanup
  1789. END IF   
  1790.  
  1791. REM - rLen& = 0  heißt EOF (Dateiende)
  1792. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  1793.    loadError$ = "Wichtige IFF-Chunks nicht gefunden."
  1794.    GOTO Lcleanup
  1795. END IF
  1796.  
  1797.  
  1798. GoodLoad:
  1799. loadError$ =""
  1800.  
  1801. REM  Farbpalette
  1802. IF foundCMAP THEN 
  1803.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  1804. END IF
  1805.  
  1806. Lcleanup:
  1807. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  1808. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  1809.  
  1810. RETURN
  1811.  
  1812.  
  1813. GetScrAddrs:
  1814. REM - Adressen von Screen-Structures ermitteln
  1815.    sWindow&   = WINDOW(7)
  1816.    sScreen&   = PEEKL(sWindow& + 46)
  1817.    sViewPort& = sScreen& + 44
  1818.    sRastPort& = sScreen& + 84
  1819.    sColorMap& = PEEKL(sViewPort& + 4)
  1820.    colorTab&  = PEEKL(sColorMap& + 4)
  1821.    sBitMap&   = PEEKL(sRastPort& + 4)
  1822.  
  1823.    REM - Screen-Parameter ermitteln
  1824.    scrwidth%  = PEEKW(sScreen& + 12)
  1825.    scrheight% = PEEKW(sScreen& + 14)
  1826.    scrDepth%  = PEEK(sBitMap& + 5)
  1827.    nColors%   = 2^scrDepth%
  1828.  
  1829.    REM - Adressen der BitPlanes ermitteln
  1830.    FOR kk = 0 TO scrDepth% - 1
  1831.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  1832.    NEXT
  1833. RETURN
  1834.  
  1835. SAMPLELoader:
  1836.  
  1837.  
  1838. OPEN "I",#1,filename$(a)
  1839. Laenge&(a)=LOF(1)
  1840. CLOSE 1
  1841. :
  1842. Mem.Opt&=2^1+2^16
  1843. Adresse&(a)=AllocMem&(Laenge&(a),Mem.Opt&)
  1844. IF Adresse&(a)=0 THEN ERROR 7
  1845. :
  1846. REM > Datei öffnen <
  1847. :
  1848. disk.name$=filename$(a)+CHR$(0)
  1849. disk.handle&=xOpen&(SADD(disk.name$),1005)
  1850. :
  1851. REM > Daten lesen <
  1852. :
  1853. disk.gelesen&=xRead&(disk.handle&,Adresse&(a),Laenge&(a))
  1854. :
  1855. REM > Datei schließen <
  1856. :
  1857. CALL xClose&(disk.handle&)
  1858. :
  1859.  
  1860. RETURN
  1861.  
  1862.  
  1863.  
  1864. Soundplayer:
  1865.  
  1866. REM > Abspielen <
  1867. :
  1868. Basis&=&Hdff0*&H100
  1869. DMA&=Basis&+&H96
  1870. AUDADR&=Basis&+&Ha0
  1871. AUDLEN&=Basis&+&Ha4
  1872. AUDSPD&=Basis&+&Ha6
  1873. AUDVOL&=Basis&+&Ha8
  1874. POKEL AUDADR&,Adresse&(num)
  1875. POKEW AUDLEN&,Laenge&(num)/2
  1876. POKEW AUDSPD&,peri
  1877. POKEW AUDVOL&,64
  1878. POKEW DMA&,&H8201
  1879. :
  1880. REM > Warten <
  1881. :
  1882. IF num=1 THEN FOR t=1 TO 2000:NEXT t
  1883. IF num=2 THEN FOR t=1 TO 6300:NEXT t
  1884. IF num=3 THEN FOR t=1 TO 12000:NEXT t
  1885. :
  1886. REM > Sound stoppen <
  1887. :
  1888. POKEW DMA&,&H1
  1889. :
  1890. RETURN
  1891.  
  1892.  
  1893. Sound1:
  1894. num=1
  1895. peri=180
  1896. GOSUB Soundplayer
  1897. RETURN
  1898.  
  1899. sound2:
  1900. num=2
  1901. peri=428
  1902. GOSUB Soundplayer
  1903. RETURN
  1904.  
  1905.  
  1906.